home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
sound
/
sample20.zip
/
SAMPLER.INC
< prev
next >
Wrap
Text File
|
1989-05-04
|
43KB
|
1,451 lines
{ Utility procedures for sampler.pas}
{$f+}
procedure samplerexit; {$f-}
{ incase graphics mode, restore text screen before error message is given
also restores keyboard interrupt on abort}
begin {samplerexit}
mem[0 : $417] := mem[0 : $417] And $fc; {shift off}
restorecrtmode;
exitproc:=exitsave;
if showerrormessage then
writeln('Exit due to internal error!');
if customkbd then
restore;
end; {samplerexit}
function index(position:longint):longint;
{ calculates buffer array index for given screen position}
begin {index}
if zoom then
index:=viewleft+position - plotxoffset
else
index:=Round((position - plotxoffset)
/ (getmaxx - 2 * plotxoffset) * bufflength);
end;{index}
function scaleord(index:longint):integer;
{ calculates screen position for indexth position in buffer array}
begin {scaleord}
if zoom then
scaleord:=index-viewleft+plotxoffset
else
scaleord:= Round(index / bufflength * (getmaxx - 2 * plotxoffset)
+ plotxoffset); {move to end of read data}
end; {scaleord}
Function keypress : Boolean;
{ assumes custom keyboard service is installed. checks if a key has been
pressed and released}
Begin
If kbdflag > 0 Then
Case keyval Of
42 : mem[0 : $417] := mem[0 : $417] Or 2; {lshift down}
54 : mem[0 : $417] := mem[0 : $417] Or 1; {rshift down}
170 : mem[0 : $417] := mem[0 : $417] And $fd; {lshift release}
182 : mem[0 : $417] := mem[0 : $417] And $fe; {rshift release}
End; {case}
keypress := (kbdflag > 0) And (keyval < 128);
End; {keypress}
Function get_inc(tune : Integer; c : Char) : Integer;
{ returns a fractional increment value for a given key based on 12th root
of 2}
Begin
get_inc := Round(tune * Exp(kbdmap[c] * 0.057762265));
{= (12th root of 2)^kbdmap[c] * tune}
End; {get_inc}
Procedure display_title(title_string:string; font, fontsize,
bcolor,color:word);
{ displays nice big bold title}
Begin
settextstyle(font, horizdir, fontsize);
settextjustify(centertext, toptext);
panel(getmaxx Div 2, 1, getmaxx-cornersize*2, Round(textheight(titlestring) * 1.1),
bcolor);
selectcolor(color);
outtextxy(getmaxx Div 2, - 4, title_string);
End; {display_title}
Procedure display_pointers(leftord,rightord,loopord:longint;
leftshow,rightshow,loopshow:boolean);
{ displays up to 3 pointers}
Begin
if leftshow and (leftord>=viewleft) and (leftord<=viewright) then
putimage(scaleord(leftord) - arrowxoff, arrowlowy, uparrowp^, xorput);
if rightshow and (rightord<=viewright) and (rightord<=viewright) then
putimage(scaleord(rightord) - arrowxoff, arrowlowy, uparrowp^, xorput);
if loopshow and (loopord>=viewleft) and (loopord<=viewright) then
putimage(scaleord(loopord) - arrowxoff, arrowhighy, downarrowp^, xorput);
End; {display_pointers}
Procedure highlight_directory_entry(fileno : Integer; extension:boolean;
highlight : Boolean);
{ highlights the currently selected file or restores if highlight=false
if extension=true then the file extension is shown also}
Var j, x, y : Integer;
str1 : String;
Begin
settextstyle(smallfont, horizdir, 4);
settextjustify(lefttext, toptext);
str1:=copy(bigemptystring,1,dirnamefieldwidth);
j := pos('.', dir[fileno]);
if extension or (j=0) then
j:=succ(length(dir[fileno]));
If highlight Then
Begin
selectcolor(dirhcolor);
selectfillstyle(solidfill, dircolor);
End
Else
Begin
selectcolor(dircolor);
selectfillstyle(solidfill, dirbcolor);
End;
x := cornersize
+ (Pred(fileno) Mod dirnamesperline) * textwidth(str1);
y := directoryyoff
+ Pred(fileno) Div dirnamesperline * textheight(' ');
bar(x, y+1, x + textwidth(Copy(str1, 1, 8)),
y + textheight(' ') );
outtextxy(x, y, Copy(dir[fileno], 1, Pred(j)));
End; {highlight_directory_entry}
Procedure getdirectory(Var dir : directory_type; pattern : String);
{read file names in current directory matching pattern to dir}
Var dirinfo : searchrec;
fileno,i : Integer;
Begin
findfirst(path+'\'+pattern, 0, dirinfo);
fileno := 1;
While doserror = 0 Do
Begin
dir[fileno] := dirinfo.name;
i:=pos('.',dir[fileno]);
if i in [1..8] then
dir[fileno]:=copy(copy(dir[fileno],1,pred(i))+' ',1,8)+
copy(dir[fileno],i,4); {right justify extension}
Inc(fileno);
findnext(dirinfo);
End;
dir[fileno] := ''; {mark end of list}
End; {getdirectory}
Procedure showdirectory(extension:string);
{ displays files with extension in current directory}
var i,j,k:integer;
Begin
settextstyle(smallfont, horizdir, 5);
settextjustify(lefttext, toptext);
fill_background(dirbcolor,solidfill,cornersize);
selectcolor(dircolor);
getdirectory(dir, '*.'+extension);
if extension='*' then
extension:='All';
outtextxy(cornersize, 0, extension+' files on ' +
path);
directoryyoff:=round(textheight(' ')*1.3);
i := 1;
While (dir[i]<>'') and (dir[Succ(i)] <> '') Do {sort dir}
Begin
j := Succ(i);
While dir[j] <> '' Do
Begin
If dir[j] < dir[i] Then {name out of sequence}
Begin
str1 := dir[j];
For k := Pred(j) Downto i Do {shift names down list}
dir[Succ(k)] := dir[k];
dir[i] := str1; {insert name in correct place}
End;
j := Succ(j);
End;
i := Succ(i);
End;
str1 := '';
For i := 1 To dirnamefieldwidth Do
str1 := str1 + ' ';
i := 1;
While dir[i] <> '' Do
Begin
highlight_directory_entry(i, (extension='All'),False);
i := Succ(i);
End;
filesavail := Pred(i);
settextstyle(smallfont, horizdir, 4);
settextjustify(lefttext, toptext);
Str(diskfree(0) shr 10, str1);
outtextxy(cornersize,
directoryyoff+(filesavail div dirnamesperline +1)
*textheight(' '),' With ' + str1 + ' k free');
End; {showdirectory}
procedure pickfile(extension:string; var pick:string);
{ shows directory list, then allows file selection by mouse or naming
specifically}
var j:integer;
c:char;
cp:clickboxtypep;
dp:dialogentryp;
manual:boolean;
function strip(s:string):string;
{ strips spaces from string and converts to lower case}
var i:integer;
begin
i:=pos(' ',s);
while i>0 do
begin
delete(s,i,1);
i:=pos(' ',s);
end;
for i:=1 to length(s) do
if s[i] in ['A'..'Z'] then
s[i]:=chr(ord(s[i])+ord('a')-ord('A'));
strip:=s;
end; {strip}
function selection:integer;
{ determines which (if any) file bar was selected}
var boxwidth,boxheight,sel:integer;
begin {selection}
boxwidth:=textwidth(copy(bigemptystring,1,dirnamefieldwidth));
boxheight:=textheight(' ');
if (mousex>cornersize) and
(mousex-cornersize<boxwidth*dirnamesperline) and
((mousex -cornersize) mod boxwidth
< textwidth(copy(bigemptystring,1,8))) and
(mousey>directoryyoff) and
(mousey-directoryyoff
<(pred(filesavail) div dirnamesperline +1)*boxheight) then
begin
sel:=(mousex-cornersize) div boxwidth +
((mousey-directoryyoff) div boxheight )*dirnamesperline+1;
if sel>filesavail then
selection:=-1
else
selection:=sel;
end
else
selection:=-1;
end; {selection}
begin {pickfile}
mousearrowoff;
showdirectory(extension);
settextstyle(defaultfont,horizdir,1);
selectcolor(dialogco